1000 REM
1020 REM            ********************************
1040 REM            *                              *
1060 REM            *       Bill of Materials      *
1080 REM            *                              *
1100 REM            ********************************
1120 REM
1140 REM
1160 REM      Designed and implemented by Kelvin Throop in September 1984
1180 REM
1200 REM
1220 REM This is a simple bill of materials report generator.  It is written
1240 REM in Microsoft Advanced BASIC (tested on the IBM PC BASICA version),
1260 REM and is mainly intended to illustrate a serious application which
1280 REM processes a DXF format attribute extract file from AutoCAD, as well
1300 REM as to serve as a jumping off point for your own attribute processing
1320 REM applications, whether created by modifying this program or simply by
1340 REM using it as a model for programs written in other languages.
1360 REM
1380 REM To use the program, first create a drawing with attributes.  You may
1400 REM use any attribute tag names you like, and assign them any values.
1420 REM If you wish to assign an explicit cost within AutoCAD, call the
1440 REM cost field COST (e.g, make its attribute tag "COST"), and place the
1460 REM cost in the field as a decimal number.  COST attributes with null
1480 REM values will be treated as if no COST attribute was present (note that
1500 REM a COST field containing zero will, however, specify a zero cost).
1520 REM
1540 REM When you are ready to produce the bill of materials report, do an
1560 REM ATTEXT in AutoCAD, specifying DXF format ("D" response).  Then run
1580 REM this program in BASIC and respond with the file name of the extract
1600 REM file (without the file type) when the program asks "Enter extract
1620 REM file name:".
1640 REM
1660 REM The format of the report generated is controlled by the DATA statements
1680 REM at the end of the program.  In a commercial application these, of
1700 REM course, would be read from a report definition file.  Note that
1720 REM all specifications in these DATA statements are case sensitive, and
1740 REM thus all attrubute tag names should be typed in capitals.  The
1760 REM program is supplied with definitions to produce a report for the
1780 REM sample drawing COUNTER supplied on the sample drawings disc.
1800 REM The first set of data statements specify the order of the fields
1820 REM to be printed in the report.  Any fields not named in this DATA
1840 REM statement will be printed, in alphabetical order, at the end of
1860 REM the named fields.
1880 REM
1900 REM Each group of DATA statements is followed by a DATA "END" statement.
1920 REM This statement is used by the program to identify the end of each
1940 REM list and should not be disturbed.
1960 REM
1980 REM The second set of DATA statements allow specification of "auto
2000 REM costing" for items in the drawing.  Each data statement in this
2020 REM set consists of three items.  The first is a field name (attribute
2040 REM tag)--the statement applies to this field.  The second item is a
2060 REM value, or "*".  If a value is given, then cost will be assigned
2080 REM only if the field named by the first item has the value given by
2100 REM the second.  The third item on the DATA statement specifies the cost
2120 REM as a decimal number.
2140 REM
2160 REM If an object in the drawing has a COST field specified, that value
2180 REM will be used.  If not, the "auto costing" statements will be
2200 REM examined in the order supplied.  The named fields are tested for
2220 REM the named values, and if a match is found, the associated cost is
2240 REM assigned to the object and the search ends.  Specifying "*" as the
2260 REM value assigns the cost to any object which posesses an attribute with
2280 REM the tag named, regardless of value.  This is useful in some
2300 REM circumstances for defaults.  Note that since the cost tests are done
2320 REM in the order supplied, you can create complex default structures.
2340 REM No logical operations are provided in costing, however, this would
2360 REM be a useful extension to the program for commercial work.
2380 REM
2400 REM The third DATA statement specifies the sort keys and subtotal fields
2420 REM for the report.  Fields will be sorted in ascending order with the
2440 REM first field named as the major key, and any successive fields used
2460 REM as increasingly minor keys.  If an asterisk appears before the
2480 REM field name in this statement, that field, and any that precede it
2500 REM will be subtotalled when the value in the field changes.  This
2520 REM allows any number of running subtotals as well as the grand total
2540 REM of items and costs at the end.
2560 REM
2580 REM The fourth DATA statement specifies a field for which duplicate
2600 REM items will be suppressed after the sort.  If duplicate suppression
2620 REM is not required, this DATA statement should be removed.  Duplicate
2640 REM suppression is handy when a part may appear in more than one
2660 REM place in a drawing.  For example, in logic design, a 74LS00 quad
2680 REM NAND gate may appear four times in the schematic, but it should
2700 REM be costed only once.  By assigning each use of the part the same
2720 REM part number (e.g., "U12"), and duplicate suppressing the part
2740 REM part number field, you can count the part only once in the bill
2760 REM of materials.  Note that in order for duplicate suppression to
2780 REM work, the sort field specifications must have sorted the items
2800 REM on the field for which duplicates are being suppressed.  If
2820 REM duplicates were removed, a message will be printed at the end
2840 REM of the report indicating this fact.
2860 REM
2880 REM At the end of the report, the total number of items and the grand
2900 REM total cost will be printed.  If any items in the report had no
2920 REM explicit cost and the automatic costing rules failed to assign a
2940 REM cost, they will be noted in the total line.  This is a useful
2960 REM warning that some items have not been costed explicitly or
2980 REM implicitly.
3000 REM
3020 REM The most severe limitation of this program for production use is
3040 REM the fact that it stores the entire attribute database in memory
3060 REM while running.  It is also quite slow, a combination of BASIC's
3080 REM speed and the simple, unoptomised, algorithms employed herein.
3100 REM These limitations are by design--this program is intended to be
3120 REM read as much as to be run--every attempt has been made to use
3140 REM techniques which illustrate in the most straightforward manner
3160 REM the essence of the tasks rather than programming tricks not
3180 REM directly related to the job being done.
3200 REM
3220 REM This program is supplied for your edification only.  It is not an
3240 REM Autodesk, Inc. official product and we do not recommend that you use
3260 REM it as supplied for production work.
3280 REM
3300 REM
3320 REM Key variables in this program:
3340 REM
3360 REM      MXTAGS%      Maximum number of attribute tags to expect (constant)
3380 REM      MXPARTS%     Maximum costing directives to expect (constant)
3400 REM
3420 REM      MTAGS%       Actual number of attribute tags used
3440 REM      NREC%        Total number of blocks with attributes in file
3460 REM
3480 REM      MTAG$(n%)    Attribute tag array
3500 REM      MLEN%(n%)    Calculated longest value for attribute n%
3520 REM      SKN%         Number of sort key fields
3540 REM      SK%(n%)      MTAG$ index of sort key field n%
3560 REM      STN%         Highest numbered sort field to subtotal break
3580 REM
3600 REM      PCOST$(1,n%) Tag value for costing directive n%
3620 REM      PCOST$(2,n%) Test value (or "*") for costing directive n%
3640 REM      PCOST(n%)    Cost to assign for directive n%
3660 REM
3680 REM      ATA$(f%,r%)  Master attribute value array gives value for
3700 REM                   field f% (corresponding to names in MTAG$) of
3720 REM                   record r% (ranging 1 to NREC%)
3740 REM
3760 REM      SKEY$(n%)    Calculated ASCII sort key for record n%
3780 REM      SPTR%(n%)    After sort, pointer to records in sorted order
3800 REM                   stored in ATA$ (e.g., ATA$(1,SPTR%(1)) is the
3820 REM                   first field of the first record after the sort).
3840 REM
3860 REM      MTAB%(n%)    Tab column for field n%
3880 REM      STT(n%)      Subtotal accumulator for key field n%
3900 REM      STC%(n%)     Identical value counter for key field n%
3920 REM      GTOT         Grand total cost accumulator
3940 REM
3960 MXTAGS%=20
3980 MXPARTS%=20
4000 COSTP%=0
4020 COSTNO%=0
4040 SKN%=0
4060 STN%=0
4080 DIM MTAG$(MXTAGS%),MLEN%(MXTAGS%),SK%(MXTAGS%)
4100 DIM PCOST$(2,MXPARTS%),PCOST(MXPARTS%)
4120 MTAGS%=0
4140 NREC%=0
4160 MINUS$="-"
4180 FOR I%=1 TO 7
4200   MINUS$=MINUS$+MINUS$
4220 NEXT I%
4240 REM
4260 REM Read the (optional) report order specifications
4280 REM
4300 FOR I%=0 TO MXTAGS%-1
4320   READ MTAG$(I%+1)
4340   IF MTAG$(I%+1)="END" THEN 4380
4360 NEXT I%
4380 MTEXPL%=I%
4400 MTAGS%=I%
4420 REM
4440 REM Read the (optional) automatic cost assignment specifications
4460 REM
4480 FOR I%=1 TO MXPARTS%
4500   READ PCOST$(1,I%)
4520   IF PCOST$(1,I%)="END" THEN 4600
4540   READ PCOST$(2,I%),PCOST(I%)
4560   COSTNO%=COSTNO%+1
4580 NEXT I%
4600 REM
4620 LINE INPUT "Enter extract file name: "; F$
4640 F$=F$+".dxx"
4660 OPEN "i",1,F$
4680 REM
4700 REM Scan the extract file and build a list of attribute
4720 REM tag names and maximum value lengths.
4740 REM
4760 PRINT
4780 PRINT "Scan extract file for field names";
4800 IF EOF(1) THEN 5260
4820 INPUT #1,FT%
4840 IF FT%<>0 THEN LINE INPUT #1,A$ : GOTO 4800
4860 LINE INPUT #1,FA$
4880 IF FA$="SEQEND" THEN NREC%=NREC%+1 : GOTO 4800
4900 IF FA$<>"ATTRIB" THEN 4800
4920 GTAG%=0
4940 GVAL%=0
4960 IF GTAG%>0 AND GVAL%>0 THEN 5080
4980 INPUT #1,FT%
5000 LINE INPUT #1,A$
5020 IF FT%=1 THEN GVAL%=1 : AVAL$=A$ : GOTO 4960
5040 IF FT%=2 THEN GTAG%=1 : ATAG$=A$ : GOTO 4960
5060 GOTO 4960
5080 FOR I%=1 TO MTAGS%
5100   IF MTAG$(I%)=ATAG$ THEN 5200
5120 NEXT I%
5140 MTAGS%=MTAGS%+1
5160 MTAG$(MTAGS%)=ATAG$
5180 I%=MTAGS%
5200 IF LEN(AVAL$)>MLEN%(I%) THEN MLEN%(I%)=LEN(AVAL$)
5220 IF LEN(ATAG$)>MLEN%(I%) THEN MLEN%(I%)=LEN(ATAG$)
5240 GOTO 4800
5260 REM End pass 1 scan
5280 CLOSE 1
5300 PRINT " - complete."
5320 REM
5340 REM Sort the attribute tags alphabetically
5360 REM
5380 FOR I%=MTEXPL%+1 TO MTAGS%
5400   FOR J%=I%+1 TO MTAGS%
5420    IF MTAG$(I%)>MTAG$(J%) THEN SWAP MTAG$(I%),MTAG$(J%) : SWAP MLEN%(I%),MLEN%(J%)
5440   NEXT J%
5460 NEXT I%
5480 FOR I%=1 TO MTAGS%
5500   IF MTAG$(I%)="COST" THEN COSTP%=I%
5520 NEXT I%
5540 IF COSTP%=0 THEN MTAGS%=MTAGS%+1 : MTAG$(MTAGS%)="COST" : COSTP%=MTAGS% : MLEN%(I%)=8
5560 REM 
5580 REM Read in the attribute fields
5600 REM
5620 PRINT "Read attributes from extract file";
5640 DIM ATA$(MTAGS%,NREC%)
5660 OPEN "i",1,F$
5680 RNO%=0
5700 IF EOF(1) THEN 6060
5720 INPUT #1,FT%
5740 IF FT%<>0 THEN LINE INPUT #1,A$ : GOTO 5700
5760 LINE INPUT #1,FA$
5780 IF FA$="SEQEND" THEN RNO%=RNO%+1 : GOTO 5700
5800 IF FA$<>"ATTRIB" THEN 5700
5820 GTAG%=0
5840 GVAL%=0
5860 IF GTAG%>0 AND GVAL%>0 THEN 5980
5880 INPUT #1,FT%
5900 LINE INPUT #1,A$
5920 IF FT%=1 THEN GVAL%=1 : AVAL$=A$ : GOTO 5860
5940 IF FT%=2 THEN GTAG%=1 : ATAG$=A$ : GOTO 5860
5960 GOTO 5860
5980 FOR I%=1 TO MTAGS%
6000  IF MTAG$(I%)=ATAG$ THEN ATA$(I%,RNO%+1)=AVAL$
6020 NEXT I%
6040 GOTO 5700
6060 CLOSE 1
6080 PRINT " - complete."
6100 REM
6120 REM Assign costs to records without explicit costs
6140 REM
6160 PRINT "Assign costs to items";
6180 FOR I%=1 TO NREC%
6200   IF LEN(ATA$(COSTP%,I%))>0 THEN 6340
6220   FOR J%=1 TO COSTNO%
6240     FOR K%=1 TO MTAGS%
6260       IF PCOST$(1,J%)<>MTAG$(K%) THEN 6300
6280       IF PCOST$(2,J%)="*" OR ATA$(K%,I%)=PCOST$(2,J%) THEN ATA$(COSTP%,I%)=STR$(PCOST(J%)) : GOTO 6340
6300     NEXT K%
6320   NEXT J%
6340 NEXT I%
6360 ERASE PCOST$,PCOST
6380 REM
6400 REM Convert cost specifications to binary for sorting
6420 REM
6440 NUSC%=0
6460 FOR I%=1 TO NREC%
6480   IF LEN(ATA$(COSTP%,I%))=0 THEN ATA$(COSTP%,I%)="0" : NUSC%=NUSC%+1
6500   ATA$(COSTP%,I%)=MKD$(VAL(ATA$(COSTP%,I%)))
6520 NEXT I%
6540 PRINT " - complete."
6560 REM
6580 REM Sort the fields on specified keys
6600 REM
6620 PRINT "Sort attributes to report order";
6640 FOR I%=1 TO MXTAGS%
6660   READ A$
6680   IF A$="END" THEN 6860
6700   SKN%=SKN%+1
6720   IF LEFT$(A$,1)="*" THEN STN%=SKN% : A$=MID$(A$,2)
6740   FOR J%=1 TO MTAGS%
6760     IF MTAG$(J%)=A$ THEN SK%(I%)=J% : GOTO 6820
6780   NEXT J%
6800   PRINT "Unknown sort field: ";A$;" - Ignored."
6820 NEXT I%
6840 REM
6860 REM Calculate blank pad string for compare in sort
6880 REM
6900 PBL%=0
6920 FOR I%=1 TO MTAGS%
6940   IF MLEN%(I%)>PBL% THEN PBL%=MLEN%(I%)
6960 NEXT I%
6980 PBS$=SPACE$(PBL%)
7000 REM
7020 REM Compose key strings from selected keys
7040 REM
7060 DIM SKEY$(NREC%),SPTR%(NREC%)
7080 FOR I%=1 TO NREC%
7100   SPTR%(I%)=I%
7120   A$=""
7140   FOR J%=1 TO SKN%
7160     F%=SK%(J%)
7180     IF F%<>COSTP% THEN 7340
7200     B$=STR$(CVD(ATA$(F%,I%)))
7220     IF INSTR(B$,".")=0 THEN B$=B$+"."
7240     WHILE LEN(B$)<11 AND MID$(B$,7,1)<>"."
7260       B$=" "+B$
7280     WEND
7300     A$=A$+LEFT$(B$+"0000000000",10)
7320     GOTO 7360
7340     A$=A$+LEFT$(ATA$(F%,I%)+PBS$,PBL%)
7360   NEXT J%
7380   SKEY$(I%)=A$
7400 NEXT I%
7420 REM
7440 REM Sort the keys and move the pointers correspondingly
7460 REM
7480 FOR J%=1 TO NREC%
7500   FOR K%=J%+1 TO NREC%
7520     IF SKEY$(K%)>=SKEY$(J%) THEN 7580
7540     SWAP SKEY$(K%),SKEY$(J%)
7560     SWAP SPTR%(K%),SPTR%(J%)
7580   NEXT K%
7600 NEXT J%
7620 ERASE SKEY$
7640 PRINT " - complete."
7660 REM
7680 REM Eliminate duplicate records in sorted output, if requested
7700 REM
7720 DUPSUP%=0
7740 READ DUPFLD$
7760 IF DUPFLD$="END" THEN 8180
7780 READ A$
7800 IF A$<>"END" THEN PRINT "Only one field may be duplicate suppressed" : STOP
7820 PRINT "Suppress duplicate items";
7840 FOR I%=1 TO MTAGS%
7860   IF DUPFLD$=MTAG$(I%) THEN 7940
7880 NEXT I%
7900 PRINT "Unknown duplicate suppress field ";DUPFLD$
7920 STOP
7940 J%=1
7960 WHILE J%<NREC%
7980   IF ATA$(I%,SPTR%(J%))<>ATA$(I%,SPTR%(J%+1)) THEN 8120
8000   FOR K%=J%+1 TO NREC%-1
8020     SPTR%(K%)=SPTR%(K%+1)
8040   NEXT K%
8060   NREC%=NREC%-1
8080   DUPSUP%=DUPSUP%+1
8100   IF J%<NREC%-1 THEN 7980
8120   J%=J%+1
8140 WEND
8160 PRINT " - complete."
8180 REM 
8200 REM Edit report
8220 REM
8240 CLS
8260 K%=0
8280 GTOT=0
8300 DIM MTAB%(MTAGS%),STT(MTAGS%),STC%(MTAGS%)
8320 REM
8340 REM Calculate tab stops for report columns
8360 REM
8380 IF MLEN%(COSTP%)<8 THEN MLEN%(COSTP%)=8
8400 FOR I%=1 TO MTEXPL%+1
8420  K%=K%+MLEN%(I%)+1
8440  MTAB%(I%)=K%+1
8460 NEXT I%
8480 REM
8500 REM Print attribute tags as column headings
8520 REM
8540 FOR I%=1 TO MTEXPL%
8560  PRINT MTAG$(I%);TAB(MTAB%(I%));
8580 NEXT I%
8600 PRINT
8620 REM
8640 REM Print minus signs below columns to better delimit them
8660 REM
8680 K%=1
8700 FOR I%=1 TO MTEXPL%
8720  PRINT LEFT$(MINUS$,MLEN%(I%));TAB(MTAB%(I%));
8740 NEXT I%
8760 PRINT
8780 REM
8800 REM Now actually print the sorted records (using pointers from sort)
8820 REM
8840 PRINT
8860 FOR QR%=1 TO NREC%
8880   R%=SPTR%(QR%)
8900   FOR SB%=1 TO STN%
8920     F%=SK%(SB%)
8940     IF QR%<2 THEN 9100
8960     IF ATA$(F%,R%)=ATA$(F%,SPTR%(QR%-1)) THEN 9100
8980     FOR SB1%=STN% TO SB%+1 STEP -1
9000       F%=SK%(SB1%)
9020       GOSUB 9460
9040     NEXT SB1%
9060     F%=SK%(SB%)
9080     GOSUB 9460
9100     STT(F%)=STT(F%)+CVD(ATA$(COSTP%,R%))
9120     STC%(F%)=STC%(F%)+1
9140   NEXT SB%
9160   GOSUB 9800
9180   PRINT
9200   GTOT=GTOT+CVD(ATA$(COSTP%,R%))
9220 NEXT QR%
9240 IF STN%=0 THEN 9340
9260 FOR SB%=STN% TO 1 STEP -1
9280   F%=SK%(SB%)
9300   GOSUB 9460
9320 NEXT SB%
9340 PRINT
9360 PRINT "Total items:";NREC%;
9380 IF NUSC%>0 THEN PRINT " (";NUSC%;"with unspecified cost)";
9400 PRINT USING "  Total cost: ######.##"; GTOT
9420 IF DUPSUP%>0 THEN PRINT DUPSUP%;"duplicate items suppressed."
9440 END
9460 REM
9480 REM Print subtotal and item count at break point
9500 REM
9520 IF STC%(F%)=0 THEN RETURN
9540 FOR J%=1 TO MTEXPL%
9560   ATA$(J%,0)=""
9580 NEXT J%
9600 ATA$(F%,0)=LEFT$(MINUS$,MLEN%(F%))
9620 SVR%=R%
9640 R%=0
9660 GOSUB 9800
9680 R%=SVR%
9700 PRINT "  Subtotal: ";STC%(F%);"items, cost: ";
9720 PRINT USING "#####.##"; STT(F%)
9740 STC%(F%)=0
9760 STT(F%)=0
9780 RETURN
9800 REM
9820 REM Print line of report
9840 REM
9860 CPOS%=0
9880 FOR I%=1 TO MTEXPL%
9900  IF R%=0 OR I%<>COSTP% THEN 9940
9920  PRINT USING "#####.##"; CVD(ATA$(I%,R%)); : GOTO 9960
9940  PRINT ATA$(I%,R%);TAB(MTAB%(I%));
9960 NEXT I%
9980 RETURN
10000 REM
10020 REM Field report order specifications follow
10040 REM
10060 DATA "PNAME","PVALUE","PSPEC1","PSPEC2","COST"
10080 DATA "END"
10100 REM
10120 REM Cost assignments follow
10140 REM
10160 DATA "PTYPE","RES",.08
10180 DATA "PVALUE","6SN7",7.55
10200 DATA "PVALUE","6L6",12.95
10220 DATA "PVALUE","6Y6",8.50
10240 DATA "PVALUE","50pF",.35
10260 DATA "PVALUE",".01uF",.79
10280 DATA "PVALUE","2.5uF",1.23
10300 DATA "PVALUE","NE2",.65
10320 DATA "END"
10340 REM
10360 REM Sort field specifications follow
10380 REM
10400 DATA "*PTYPE","PNAME"
10420 DATA "END"
10440 REM
10460 REM Duplicate suppression specification follows
10480 REM
10500 DATA "PNAME"
10520 DATA "END"
